home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / faq-s.zip / PROTEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-24  |  19KB  |  628 lines
  1. program makeproto;
  2.  
  3. {$R-,S+,I-,D+,F-,V-,B-,N-,L+ }
  4. {$M 16384,5000,5000 }
  5.  
  6. uses configrt,gentypes,general,dos,crt;
  7.  
  8. type
  9.   fstr=string[8];
  10.  
  11. const protver='1.00';
  12.  
  13. type protorec = record
  14.               letter:char;
  15.                 desc:string[30];
  16.             progname:string[12];
  17.                 comm:string[60];
  18.               end;
  19.  
  20. var pro:file of protorec; prots:protorec; which:char;
  21.     filenm: string[15];
  22.     updated:boolean;
  23.     thekruft:string;
  24.     protlist:array [1..120] of protorec; count:integer; work:string[80];
  25.  
  26. procedure makefile(fname:string);
  27. var ff:file of protorec; frec:protorec;
  28. begin
  29.      assign(ff,fname);
  30.      rewrite(ff);
  31.      frec.letter:='Z';
  32.      frec.desc:='External Zmodem';
  33.      frec.progname:='DSZ.COM';
  34.      frec.comm:=' port %1 speed %2 sz %3';
  35.      write(ff,frec);
  36.      close(ff);
  37. end;
  38.  
  39. function exist(fname:string):boolean;
  40. var ff:file;
  41. begin
  42.      assign(ff,fname); {$I-};
  43.      reset(ff); {$I+};
  44.      exist:=(ioresult=0);
  45. end;
  46.  
  47.  
  48.  
  49. procedure dobar(width:integer);
  50. var ct:integer;
  51. begin
  52.      write('[');
  53.      for ct:=1 to width do write('─');
  54.      writeln(']');
  55. end;
  56.  
  57. procedure readyfile;
  58. begin
  59.      count:=0; reset(pro);
  60.      while not eof(pro) do begin
  61.                count:=count+1;
  62.                read(pro,prots);
  63.                protlist[count].letter:=prots.letter;
  64.                protlist[count].desc:=prots.desc;
  65.                protlist[count].comm:=prots.comm;
  66.                protlist[count].progname:=prots.progname;
  67.                end;
  68. end;
  69.  
  70. procedure tab (n:anystr; np:integer);
  71. var cnt:integer;
  72. begin
  73.   write (n);
  74.   for cnt:=length(n) to np-1 do begin
  75.    write (' ');
  76.   end;
  77. end;
  78.  
  79. {Procedure DoLonglist;
  80. var ct:integer;
  81. begin;
  82.       writeln;
  83.       textcolor (9);
  84.       write('[');
  85.       textcolor (11);
  86.       write('#');
  87.       textcolor (9);
  88.       write('] [');
  89.       textcolor (11);
  90.       write('Ltr');
  91.       textcolor (9);
  92.       write('] [');
  93.       textcolor (11);
  94.       write('Description of the Protocols');
  95.       textcolor (9);
  96.       write('] [');
  97.       textcolor (11);
  98.       write('Command Line of the Protocols');
  99.       textcolor (9);
  100.       writeln(']');
  101.       textcolor (15);
  102.  
  103. For ct:=1 to count do begin
  104.           write(ct:2,'    ',protlist[ct].letter,'   ');
  105.           tab (protlist[ct].desc,31); writeln(protlist[ct].progname+protlist[ct].comm);
  106.           end;
  107.       writeln;
  108. textcolor (11);
  109. end;
  110. }
  111.  
  112. procedure spacelen(le:byte);
  113.    var aaa:byte;
  114.    begin
  115.     for aaa:=1 to le do
  116.     write(' ');
  117. end;
  118.  
  119. procedure top;
  120. procedure wb(s: string);
  121. begin
  122.      textcolor(9);
  123.      write(s);
  124. end;
  125. procedure wy(s: string);
  126. begin
  127.      textcolor(11);
  128.      write(s);
  129. end;
  130. begin
  131.      textcolor(9);
  132.      writeln('   ┌───┬─────┬─────────────────────────────┬───────────────────────────────┐');
  133.      wb('   │');wy(' #');wb(' │');wy(' Ltr');wb(' │');wy('        Description');
  134.      wb('          │');wy('         Command Line');textcolor(9);writeln('          │');
  135.      textcolor(9);
  136.      writeln('   ├───┼─────┼─────────────────────────────┼───────────────────────────────┤');
  137.      textcolor(15);
  138. end;
  139.  
  140. procedure bottom;
  141. begin
  142.      textcolor(9);
  143.      writeln('   └───┴─────┴─────────────────────────────┴───────────────────────────────┘');
  144.      textcolor(15);
  145. end;
  146.  
  147. Procedure DoLonglist;
  148. var ct:integer;
  149. begin;
  150.       writeln;
  151.       if count<1 then
  152.       begin
  153.            textcolor(11);
  154.            writeln('No Protocols exist! Use [A] to add one.');
  155.            textcolor(15);
  156.            writeln;
  157.            exit;
  158.       end;
  159.       top;
  160. For ct:=1 to count do begin
  161.           textcolor(9);
  162.           write('   │');
  163.           textcolor(15);
  164.           write(ct:2);textcolor(9);write(' │  ');
  165.           textcolor(15);write(protlist[ct].letter);
  166.           textcolor(9);write('  │');textcolor(15);
  167.           write(protlist[ct].desc);textcolor(9);
  168.           spacelen(29-length(protlist[ct].desc));
  169.           write('│');textcolor(15);
  170.           if length(protlist[ct].progname+protlist[ct].comm) < 31 then
  171.           begin
  172.                write(protlist[ct].progname+protlist[ct].comm);
  173.                spacelen(31-length(protlist[ct].progname+protlist[ct].comm));
  174.           end else
  175.           begin
  176.                thekruft:=protlist[ct].progname+protlist[ct].comm;
  177.                delete(thekruft,29,length(thekruft));
  178.                textcolor(15);
  179.                write(thekruft);
  180.                write('   ');
  181.                textcolor(15);
  182.                spacelen(31-length(thekruft+'   '));
  183.           end;
  184.           textcolor(9);writeln('│');
  185.           textcolor(15);
  186.           end;
  187.           bottom;
  188.       writeln;
  189. end;
  190.  
  191. Procedure GetParm(addit:string; lump:integer);
  192. begin
  193.      textcolor (11);
  194.      writeln;
  195.      writeln('Enter the ',addit,' protocol.');
  196.      dobar(lump);
  197.        write(':'); textcolor (12); readln(work);
  198. end;
  199.  
  200. procedure edit;
  201. var
  202.    ct: integer;
  203.    editnum: integer;
  204.    done: boolean;
  205.  
  206. Function chg(dood: string): string;
  207. var news: string;
  208. begin
  209.      textcolor(15);
  210.      writeln;
  211.      write('New '+dood); readln(news);
  212.      if length(news)<1 then chg:='Undefined' else
  213.      begin
  214.           chg:=news;
  215.           updated:=true;
  216.      end;
  217.      writeln;
  218. end;
  219.  
  220. Function changeprot(s:char;dude:string): char;
  221. var newc: string;
  222. begin
  223.      textcolor(15);
  224.      writeln;
  225.      write('New '+dude);readln(newc);
  226.      if newc='' then changeprot:='!' else
  227.      begin
  228.           changeprot:=upcase(newc[1]);
  229.           updated:=true;
  230.      end;
  231. end;
  232.  
  233. begin
  234.      writeln;textcolor(15);
  235.      write('Edit which protocol? [#]: '); readln(editnum);
  236.      if (editnum > count) or (editnum <= 0) then
  237.                 writeln('Invalid must be between 1-',count,'!');
  238.      if (editnum > count) or (editnum <= 0) then exit;
  239.      writeln;
  240.      textcolor(9);
  241.      write('[');
  242.      textcolor (15);write('L');
  243.      textcolor (9);write('] ');
  244.      textcolor (11);write('Letter       : ');textcolor(15);writeln(protlist[editnum].letter);
  245.      textcolor(9);
  246.      write('[');
  247.      textcolor (15);write('D');
  248.      textcolor (9);write('] ');
  249.      textcolor (11);write('Description  : ');textcolor(15);writeln(protlist[editnum].desc);
  250.      textcolor(9);
  251.      write('[');
  252.      textcolor (15);write('P');
  253.      textcolor (9);write('] ');
  254.      textcolor (11);write('Program Name : ');textcolor(15);writeln(protlist[editnum].progname);
  255.      textcolor(9);
  256.      write('[');
  257.      textcolor (15);write('C');
  258.      textcolor (9);write('] ');
  259.      textcolor (11);write('Command Line : ');textcolor(15);writeln(protlist[editnum].comm);
  260.      writeln;
  261.      textcolor(9);
  262.      write('[Edit Option] [CR/Quit]: ');
  263.      textcolor(12);
  264.      which:=upcase(readkey);
  265.      writeln(which);
  266.      case which of
  267.           'L'   : protlist[editnum].letter:=changeprot('?','Letter: ');
  268.           'D'   : protlist[editnum].desc:=chg('Description: ');
  269.           'P'   : protlist[editnum].progname:=chg('Program Name: ');
  270.           'C'   : begin
  271.                        protlist[editnum].comm:=chg('Command Line: ');
  272.                        protlist[editnum].comm:=' '+protlist[editnum].comm;
  273.                   end;
  274.           #13   : begin writeln;
  275.      textcolor (11);
  276.      write('Protocol Changed');
  277.      textcolor (9);
  278.      write('.  [');
  279.      textcolor (15);
  280.      write('S');
  281.      textcolor (9);
  282.      write(']');
  283.      textcolor (11);
  284.      write('ave to make permanent');
  285.      textcolor (9);
  286.      write('.'#13);
  287.       end;
  288.      end;
  289.      exit;
  290. end;
  291.  
  292. procedure Newprotocol;
  293. begin
  294.      writeln; count:=count+1;
  295.      textcolor (11);
  296.      writeln('Will be added as #',count,' to list.'); writeln;
  297.      getparm('letter to respresent this',1); writeln;
  298.      protlist[count].letter:=upcase(work[1]);
  299.      getparm('description of the',30);
  300.      protlist[count].desc:=copy(work,1,30);
  301.      getparm('program name (i.e. DSZ.COM, LYNX.EXE) of this',12);
  302.      protlist[count].progname:=copy(work,1,12); writeln; writeln;
  303.      textcolor (11);
  304.      writeln('Below show the PARAMETER-ONLY portion of the command line');
  305.      writeln('Use : %1=Port   %2=Speed   %3=File/Pathname');
  306.      writeln('(Ex: port=%1 baud=%2 R %3)  Be sure to remember WHICH protocol');
  307.      writeln('list you are editing and have the command line reflect that.');
  308.      writeln('(Ex: If you are adding an UPLOAD, you may have to type "R" or');
  309.      writeln('"RZ" on the command line.  A seperate entry must be made for');
  310.      writeln('other operations.');
  311.      getparm('command line format for the',60);
  312.      protlist[count].comm:=' '+copy(work,1,60);
  313.      textcolor (11);
  314.      writeln; writeln(protlist[count].desc,' added.  [S]ave to make permanent.');
  315. writeln('Be sure that ',protlist[count].progname,' exists in your FAQ directory.');
  316.      writeln;
  317. end;
  318.  
  319. {procedure Changeprot;
  320. begin
  321.      write ('Protocol # to Change: ');
  322.      readln(count2);
  323.      if valu (count2)=0 then exit;
  324.      textcolor (9);
  325.      write (^M'[');
  326.      textcolor (11);
  327.      write ('A');
  328.      textcolor (9);
  329.      write (']');
  330.      textcolor (15);
  331.      write (' Letter     : ');
  332.      textcolor (11);
  333.      writeln (protlist[count].letter);
  334.      textcolor (9);
  335.      write ('[');
  336.      textcolor (11);
  337.      write ('B');
  338.      textcolor (9);
  339.      write (']');
  340.      textcolor (15);
  341.      write (' Description: ');
  342.      textcolor (11);
  343.      writeln (protlist[count].desc);
  344.      write ('[');
  345.      textcolor (11);
  346.      write ('C');
  347.      textcolor (9);
  348.      write (']');
  349.      textcolor (15);
  350.      write (' Program Name: ');
  351.      textcolor (11);
  352.      writeln (protlist[count].progname);
  353.      write ('[');
  354.      textcolor (11);
  355.      write ('D');
  356.      textcolor (9);
  357.      write (']');
  358.      textcolor (15);
  359.      write (' Command Line: ');
  360.      textcolor (11);
  361.      writeln (protlist[count].progname);
  362.      writeln (^M'Change Protocol Command [Q/Quit]: ');
  363.      getparm('letter to respresent this',1); writeln;
  364.      protlist[count].letter:=upcase(work[1]);
  365.      getparm('description of the',30);
  366.      protlist[count].desc:=copy(work,1,30);
  367.      getparm('program name (i.e. DSZ.COM, LYNX.EXE) of this',12);
  368.      protlist[count].progname:=copy(work,1,12); writeln; writeln;
  369.      textcolor (11);
  370.      writeln('Below show the PARAMETER-ONLY portion of the command line');
  371.      writeln('Use : %1=Port   %2=Speed   %3=File/Pathname');
  372.      writeln('(Ex: port=%1 baud=%2 R %3)  Be sure to remember WHICH protocol');
  373.      writeln('list you are editing and have the command line reflect that.');
  374.      writeln('(Ex: If you are adding an UPLOAD, you may have to type "R" or');
  375.      writeln('"RZ" on the command line.  A seperate entry must be made for');
  376.      writeln('other operations.');
  377.      getparm('command line format for the',60);
  378.      protlist[count].comm:=' '+copy(work,1,60);
  379.      textcolor (11);
  380.      writeln; writeln(protlist[count].desc,' added.  [S]ave to make permanent.');
  381. writeln('Be sure that ',protlist[count].progname,' exists in your FAQ directory.');
  382.      writeln;
  383. end;}
  384.  
  385. procedure deleteprotocol;
  386. var delnum:integer; resp:char; lp:integer;
  387. begin
  388.      textcolor (15);
  389.      writeln;
  390.      write('Delete which protocol? [#]: '); textcolor(12); readln(delnum);
  391.      textcolor (15);
  392.      if (delnum > count) or (delnum <= 0) then
  393.                 writeln('Invalid... must be between 1-',count,'!');
  394.      if (delnum > count) or (delnum <= 0) then exit;
  395.      writeln;textcolor(11);
  396.      write('Remove "',protlist[delnum].desc,'" from list? ');
  397.      textcolor(12);
  398.      resp:=upcase(readkey);
  399.      if resp='N' then
  400.      begin
  401.           writeln('No');
  402.           exit;
  403.      end else writeln('Yes');
  404.      for lp:=delnum to count do begin;
  405.          protlist[lp].letter:=protlist[lp+1].letter;
  406.          protlist[lp].desc  :=protlist[lp+1].desc;
  407.          protlist[lp].comm  :=protlist[lp+1].comm;
  408.        protlist[lp].progname:=protlist[lp+1].progname;
  409.        end;
  410.      writeln;
  411.      textcolor (11);
  412.      write('Protocol Deleted');
  413.      textcolor (9);
  414.      write('.  [');
  415.      textcolor (15);
  416.      write('S');
  417.      textcolor (9);
  418.      write(']');
  419.      textcolor (11);
  420.      write('ave to make permanent');
  421.      textcolor (9);
  422.      write('.');
  423.      writeln; count:=count-1;
  424. end;
  425.  
  426. function getyn(s: string):boolean;
  427. var ch: char;
  428. begin
  429.      getyn:=false;
  430.      textcolor(11);
  431.      write(s+' ');
  432.      textcolor(12);
  433.      ch:=upcase(readkey);
  434.      if ch='Y' then
  435.      begin
  436.           writeln('Yes');
  437.           getyn:=true;
  438.      end else
  439.      begin
  440.           writeln('No');
  441.           getyn:=false;
  442.      end;
  443. end;
  444.  
  445. procedure savelist;
  446. var ct:integer;
  447. begin
  448.      rewrite(pro);
  449.      for ct:=1 to count do write(pro,protlist[ct]);
  450. end;
  451.  
  452.  
  453. begin;
  454.       updated:=false;
  455.       readconfig;
  456.       if not exist (bbsdatadir+'con') then
  457.       mkdir (copy(bbsdatadir,1,length(bbsdatadir)-1));
  458.       if exist (faqdir+'protr.cfg') and not (exist(bbsdatadir+'protr.cfg')) then begin
  459.       exec (getenv('COMSPEC'),'/C copy '+faqdir+'protr.cfg '+bbsdatadir+'protr.cfg >nul');
  460.       exec (getenv('COMSPEC'),'/C del '+faqdir+'protr.cfg >nul'); end;
  461.       if exist (faqdir+'prots.cfg') and not (exist(bbsdatadir+'prots.cfg')) then begin
  462.       exec (getenv('COMSPEC'),'/C copy '+faqdir+'prots.cfg '+bbsdatadir+'prots.cfg >nul');
  463.       exec (getenv('COMSPEC'),'/C del '+faqdir+'prots.cfg >nul'); end;
  464.       if exist (faqdir+'protu.cfg') and not (exist(bbsdatadir+'protu.cfg')) then begin
  465.       exec (getenv('COMSPEC'),'/C copy '+faqdir+'protu.cfg '+bbsdatadir+'protu.cfg >nul');
  466.       exec (getenv('COMSPEC'),'/C del '+faqdir+'protu.cfg >nul'); end;
  467.       if exist (faqdir+'protd.cfg') and not (exist(bbsdatadir+'protd.cfg')) then begin
  468.       exec (getenv('COMSPEC'),'/C copy '+faqdir+'protd.cfg '+bbsdatadir+'protd.cfg >nul');
  469.       exec (getenv('COMSPEC'),'/C del '+faqdir+'protd.cfg >nul'); end;
  470.       if not exist(bbsdatadir+'PROTR.CFG') then makefile(bbsdatadir+'PROTR.CFG');
  471.       if not exist(bbsdatadir+'PROTS.CFG') then makefile(bbsdatadir+'PROTS.CFG');
  472.       if not exist(bbsdatadir+'PROTU.CFG') then makefile(bbsdatadir+'PROTU.CFG');
  473.       if not exist(bbsdatadir+'PROTD.CFG') then makefile(bbsdatadir+'PROTD.CFG');
  474.       clrscr;
  475.       textcolor (9);
  476.       write('[');
  477.       textcolor (11);
  478.       write('FAQ Protocol Editor - v'+protver+' / '+date+'  (C)Copyright FAQ Staff, 1991');
  479.       textcolor (9);
  480.       writeln(']');
  481.       writeln;
  482.       textcolor (9);
  483.       writeln('┌────────────────────────────────┐');
  484.       write  ('│ [');
  485.       textcolor (15);
  486.       write ('R');
  487.       textcolor (9);
  488.       write  (']');
  489.       textcolor (11);
  490.       write  (' Upload/Send Protocols      ');
  491.       textcolor (9);
  492.       writeln('│');
  493.       write  ('│ [');
  494.       textcolor (15);
  495.       write ('S');
  496.       textcolor (9);
  497.       write  (']');
  498.       textcolor (11);
  499.       write  (' Download/Receive Protocols ');
  500.       textcolor (9);
  501.       writeln('│');
  502.       write  ('│ [');
  503.       textcolor (15);
  504.       write ('U');
  505.       textcolor (9);
  506.       write  (']');
  507.       textcolor (11);
  508.       write  (' Batch Upload Protocols     ');
  509.       textcolor (9);
  510.       writeln('│');
  511.       write  ('│ [');
  512.       textcolor (15);
  513.       write ('D');
  514.       textcolor (9);
  515.       write  (']');
  516.       textcolor (11);
  517.       write  (' Batch Download Protocols   ');
  518.       textcolor (9);
  519.       writeln('│');
  520.       writeln('└────────────────────────────────┘');
  521.       writeln;
  522.       textcolor (9); write ('Protocol or '); textcolor (15); write ('Q');
  523.       textcolor (9); write ('/Quit: '); textcolor (12);
  524.       repeat
  525.       which:=upcase(readkey);
  526.       until (which='U') or (which='D') or (which='R') or (which='S') or (which='Q');
  527.       if (which='Q') then
  528.       begin
  529.            textcolor (12);
  530.            writeln; writeln('Terminated.');
  531.            textcolor (7);
  532.            halt(1);
  533.       end;
  534.       writeln(which);
  535.       which:=upcase(which);
  536.       filenm:='PROT'+which+'.CFG';
  537.       assign(pro,bbsdatadir+filenm);
  538.  
  539.       readyfile;
  540.       writeln; writeln;
  541.       textcolor (9);
  542.       write('[');
  543.       textcolor (11);
  544.       write('Protocol File: ',filenm,' with ',count,' entries');
  545.       textcolor (9);
  546.       writeln(']');
  547.       which:='X'; writeln;
  548.  
  549.       while (which<>'Q') do begin
  550.       textcolor (15); write ('C'); textcolor (9); write (',');
  551.       textcolor (15); write ('L'); textcolor (9); write (',');
  552.       textcolor (15); write ('S'); textcolor (9); write (',');
  553.       textcolor (15); write ('A'); textcolor (9); write (',');
  554.       textcolor (15); write ('D'); textcolor (9); write (',');
  555.       textcolor (15); write ('Q'); textcolor (9); write (',');
  556.       textcolor (15); write ('?');
  557.       textcolor (9); write ('-Enter Command, '); textcolor (15); write ('Q');
  558.       textcolor (9); write ('/Quit, or '); textcolor (15); write ('?');
  559.       textcolor (9); write ('/Help: '); textcolor (12);
  560.       repeat
  561.       which:=upcase(readkey);
  562.       until (which='C') or (which='L') or (which='S') or (which='A') or (which='D') or (which='Q') or (which='?');
  563.             writeln(which);
  564.             case which of
  565.                        'C'   : edit;
  566.                        'L'   : dolonglist;
  567.                        'S'   : savelist;
  568.                        'A'   : newprotocol;
  569.                        'D'   : deleteprotocol;
  570.                        '?'   : begin
  571.       writeln;
  572.       textcolor (9);
  573.       writeln('┌────────────────────────────────┐');
  574.       write  ('│ [');
  575.       textcolor (15);
  576.       write ('C');
  577.       textcolor (9);
  578.       write  (']');
  579.       textcolor (11);
  580.       write  (' Change Protocol Entry      ');
  581.       textcolor (9);
  582.       writeln('│');
  583.       write  ('│ [');
  584.       textcolor (15);
  585.       write ('L');
  586.       textcolor (9);
  587.       write  (']');
  588.       textcolor (11);
  589.       write  (' List Protocol Entries      ');
  590.       textcolor (9);
  591.       writeln('│');
  592.       write  ('│ [');
  593.       textcolor (15);
  594.       write ('S');
  595.       textcolor (9);
  596.       write  (']');
  597.       textcolor (11);
  598.       write  (' Save Protocol Entries      ');
  599.       textcolor (9);
  600.       writeln('│');
  601.       write  ('│ [');
  602.       textcolor (15);
  603.       write ('A');
  604.       textcolor (9);
  605.       write  (']');
  606.       textcolor (11);
  607.       write  (' Add Protocol Entry         ');
  608.       textcolor (9);
  609.       writeln('│');
  610.       write  ('│ [');
  611.       textcolor (15);
  612.       write ('D');
  613.       textcolor (9);
  614.       write  (']');
  615.       textcolor (11);
  616.       write  (' Delete Protocol Entry      ');
  617.       textcolor (9);
  618.       writeln('│');
  619.       writeln('└────────────────────────────────┘');
  620.       writeln; end;
  621.                        else writeln;
  622.                        end;
  623.       end;
  624.       textcolor (12);
  625.       if updated and getyn('Save Changes? [y/n]:') then savelist;
  626.       writeln('Done: Returning to DOS'); textcolor (7); close(pro);
  627. end.
  628.